home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / S9301.ZIP;1 / SPENCE.ZIP / RADIOS.PRG
Encoding:
Text File  |  1992-10-06  |  5.9 KB  |  230 lines
  1. #include "Getexit.ch"
  2. #include "InKey.ch"
  3.  
  4. #define K_SPACE 32
  5. #define RADIO_BUTTON Chr(4)
  6.  
  7. #command @ <row>, <col> GET <var>                                ;
  8.                         RADIO <radios,...>                       ;
  9.                                                                  ;
  10.       =>                                                         ;
  11.          SetPos(<row>, <col>)                                    ;
  12.          ; RadioGets({|x| iif(x == NIL, <var>, <var> := x) },    ;
  13.                      <(var)>, {<radios>}, GetList)               ;
  14.          ; DrawRadios(GetList, Atail(GetList))
  15.  
  16. MEMVAR GetList
  17.  
  18. FUNCTION RadioTest
  19.  
  20. LOCAL cPayType := ""
  21. LOCAL cSex := ""
  22.  
  23.   CLEAR SCREEN
  24.  
  25.   // Radio buttons group 1
  26.   // Start with Amex selected
  27.   cPayType = "Amex"
  28.   @ 5, 10 SAY "Payment Type"
  29.   @ 6, Col() GET cPayType RADIO "Amex", "M/C", "Visa", "Diners"
  30.  
  31.   // Radio buttons group 2
  32.   @ 15, 10 SAY "Sex"
  33.   @ 16, Col() GET cSex RADIO "Male", "Female", "Not tonight dear"
  34.   READ
  35.  
  36. RETURN NIL
  37.  
  38.  
  39. // Issue radio button gets for array of character strings contained in
  40. // aChoices. bVar is a get/set block for the get variable, cVar is the
  41. // variable name.
  42. FUNCTION RadioGets(bVar, cVar, aChoices, aGetList)
  43.  
  44. LOCAL oGet
  45. LOCAL nRow := Row(), nCol := Col()
  46. LOCAL nGets := Len(aChoices)
  47. LOCAL nGet
  48. LOCAL nStartGet := Len(aGetList) + 1
  49. LOCAL nSaveRow, nSaveCol
  50.  
  51.   // For each element in aChoices
  52.   FOR nGet := 1 To nGets
  53.  
  54.     // Display ( ) before the get
  55.     DevPos(nRow, nCol)
  56.     DevOut("( ) ")
  57.  
  58.     // Create an empty get object and add it to the list
  59.     oGet := GetNew()
  60.     Aadd(aGetList, oGet)
  61.  
  62.     // Its position is 4 spaces to the right of the cursor
  63.     // (just past ( ) )
  64.     oGet:col   := nCol + 4
  65.  
  66.     // We increment the row number so the
  67.     oGet:row   := nRow++
  68.  
  69.     // Set get:name for hot keys
  70.     oGet:name  := cVar
  71.  
  72.     // Here's where it gets a bit tricky. The get object's get/set
  73.     // block must just return the character string describing the
  74.     // radio button ("Amex", e.g. ). We cannot, however, set it as:
  75.     //    {|| aChoices[nGet] }
  76.     // as this code block is reevaluated at READ time when nGet is
  77.     // invalid. We solve the problem with a detached local.
  78.     oGet:block := t(aChoices[nGet])
  79.  
  80.     // Cargo is an arry of two elements. The first element contains
  81.     // the get/set block for the real variable, the second element
  82.     // is an array of offsets inside getlist of the other gets that
  83.     // comprise the radio buttons
  84.     oGet:cargo := {bVar, Array(nGets)}
  85.  
  86.     // Fill cargo[2] with element numbers of other gets in radio
  87.     // button list. nStartGet is the element number of the first one.
  88.     Aeval(oGet:cargo[2], {|x, n| oGet:cargo[2, n] := nStartGet + n - 1})
  89.  
  90.     // Radio gets have their own reader, of course
  91.     oGet:reader := {|o| RadioReader(o, aGetList) }
  92.     oGet:display()
  93.   NEXT
  94.  
  95. RETURN oGet
  96.  
  97.  
  98. // Just return a code block, which, when evaluated, will return c.
  99. // As the returned code block references a local variable that variable
  100. // becomes "detached" from the activation stack.
  101. FUNCTION t(c)
  102.  
  103. RETURN {|x| c }
  104.  
  105.  
  106. // The reader for radio buttons
  107. Proc RadioReader( oGet, aGetList )
  108.  
  109.   // read the GET if the WHEN condition is satisfied
  110.   IF ( GetPreValidate(oGet) )
  111.     // activate the GET for reading
  112.     oGet:SetFocus()
  113.  
  114.     DO WHILE ( oGet:exitState == GE_NOEXIT )
  115.       // check for initial typeout (no editable positions)
  116.       IF ( oGet:typeOut )
  117.         oGet:exitState := GE_ENTER
  118.       ENDIF
  119.  
  120.       // apply keystrokes until exit
  121.       DO WHILE ( oGet:exitState == GE_NOEXIT )
  122.         RadioApplyKey(oGet, InKey(0), aGetList)
  123.       ENDDO
  124.  
  125.       // disallow exit if the VALID condition is not satisfied
  126.       IF ( !GetPostValidate(oGet) )
  127.         oGet:exitState := GE_NOEXIT
  128.       ENDIF
  129.     ENDDO
  130.  
  131.     // de-activate the GET
  132.     oGet:KillFocus()
  133.   ENDIF
  134.  
  135. RETURN
  136.  
  137.  
  138. PROC RadioApplyKey(oGet, nKey, aGetList)
  139.  
  140. LOCAL cKey
  141. LOCAL bKeyBlock
  142. LOCAL nSaveRow, nSaveCol
  143.  
  144.   // check for SET KEY first
  145.   IF ( (bKeyBlock := SetKey(nKey)) <> NIL )
  146.     GetDoSetKey(bKeyBlock, oGet)
  147.     RETURN  // NOTE
  148.   ENDIF
  149.  
  150.   DO CASE
  151.     CASE ( nKey == K_UP )
  152.       oGet:exitState := GE_UP
  153.  
  154.     CASE ( nKey == K_SH_TAB )
  155.       oGet:exitState := GE_UP
  156.  
  157.     CASE ( nKey == K_DOWN )
  158.       oGet:exitState := GE_DOWN
  159.  
  160.     CASE ( nKey == K_TAB )
  161.       oGet:exitState := GE_DOWN
  162.  
  163.     CASE ( nKey == K_ENTER )
  164.       oGet:exitState := GE_ENTER
  165.  
  166.     CASE nKey == K_SPACE
  167.       // Toggle state of this radio button. If the get
  168.       // currently contains this radio button, clear it.
  169.       // If it does not, set it to that value
  170.       IF Eval(oGet:cargo[1]) == Eval(oGet:block)
  171.         Eval(oGet:cargo[1], "")
  172.       ELSE
  173.         Eval(oGet:cargo[1], Eval(oGet:block))
  174.       ENDIF
  175.  
  176.       // And redraw the getlist
  177.       DrawRadios(aGetlist, oGet)
  178.  
  179.     CASE ( nKey == K_ESC )
  180.       IF ( Set(_SET_ESCAPE) )
  181.         oGet:undo()
  182.         oGet:exitState := GE_ESCAPE
  183.       ENDIF
  184.  
  185.     CASE (nKey == K_PGUP )
  186.       oGet:exitState := GE_WRITE
  187.  
  188.     CASE (nKey == K_PGDN )
  189.       oGet:exitState := GE_WRITE
  190.  
  191.     CASE ( nKey == K_CTRL_HOME )
  192.       oGet:exitState := GE_TOP
  193.  
  194.     // both ^W and ^End terminate the READ (the default)
  195.     CASE (nKey == K_CTRL_W)
  196.       oGet:exitState := GE_WRITE
  197.  
  198.     CASE (nKey == K_INS)
  199.       Set( _SET_INSERT, !Set(_SET_INSERT) )
  200.  
  201.   ENDCASE
  202.  
  203. RETURN
  204.  
  205.  
  206. // Draw all radio buttons in aGetList to which the get object in
  207. // oGet is attached
  208. PROC DrawRadios(aGetList, oGet)
  209.  
  210. LOCAL cSelected := Eval(oGet:cargo[1])
  211. LOCAL nRadios   := Len(oGet:cargo[2])
  212. LOCAL oGet1
  213. LOCAL nSaveRow := Row()
  214. LOCAL nSaveCol := Col()
  215. LOCAL nGet
  216.  
  217.   FOR nGet := 1 TO nRadios
  218.     oGet1 := aGetList[oGet:cargo[2, nGet]]
  219.     DevPos(oGet1:row, oGet1:col - 3)
  220.     IF Eval(oGet1:cargo[1]) == Eval(oGet1:block)
  221.       DevOut(RADIO_BUTTON)
  222.     ELSE
  223.       DevOut(" ")
  224.     ENDIF
  225.   NEXT
  226.  
  227.   DevPos(nSaveRow, nSaveCol)
  228.  
  229. RETURN
  230.